home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / oberonv4 / oberon-src / system / popupelems.mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1996-01-09  |  19.4 KB  |  461 lines

  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. Syntax10b.Scn.Fnt
  4. FoldElems
  5. MODULE PopupElems;    (** Original by Michael Franz, 27.1.92, SHML, MH, CM 5 Sep 94 **)
  6.     (* new file format, added Version tag and options, drop down menu by CM, Uni Linz *)
  7.     (* change ErrorMsg, Save, Restore if necessary! *)
  8.     IMPORT
  9.         Amiga, Pictures, Oberon, Input, Display, Viewers, Files, Fonts, Printer,
  10.         Texts, TextFrames, MenuViewers, TextPrinter, Modules;
  11.     CONST
  12.         VersionTag = 01X; CR = 0DX;
  13.         menuElem = 0; underlined = 1;    (* elem is a MenuElem, MenuElem is underlined *)
  14.         ElemDW = 4; ElemDH = 2; MenuDW = 3; MenuDH = 1;    (* margins of element box and menu box *)
  15.         DUnit = TextFrames.Unit; PUnit = TextPrinter.Unit;
  16.         MR = 0; MM = 1; ML = 2; cancel = {ML, MM, MR};
  17.         white = Display.white; black = Display.black;
  18.         paint = Display.paint; replace = Display.replace; invert = Display.invert;
  19.     TYPE
  20.         Elem = POINTER TO ElemDesc;
  21.         ElemDesc = RECORD (Texts.ElemDesc)
  22.             name: ARRAY 32 OF CHAR;
  23.             menu: Texts.Text;
  24.             n, default, width, lsp, dsc: INTEGER;    (* number of items, default item, width, line space, descender *)
  25.             options: SET    (* menuElem, underlined *)
  26.         END;
  27.         EditFrame = POINTER TO EditFrameDesc;
  28.         EditFrameDesc = RECORD (TextFrames.FrameDesc)
  29.             elem: Elem
  30.         END;
  31.     VAR wr: Texts.Writer; buf: Texts.Buffer; saveArea:Pictures.Picture; xeHandle: Display.Handler;
  32.     PROCEDURE Str(s: ARRAY OF CHAR);    BEGIN Texts.WriteString(wr, s) END Str;
  33.     PROCEDURE Ln;    BEGIN Texts.WriteLn(wr) END Ln;
  34.     (* non_portable stuff *)    
  35.     PROCEDURE ErrorMsg(name: ARRAY OF CHAR; res: INTEGER);    (* not portable!!! *)
  36.     BEGIN
  37.         IF res > 0 THEN
  38.             Str("Call error: "); Str(Modules.importing);
  39.             IF res = 1 THEN Str(" not found")
  40.             ELSIF res = 2 THEN Str(" not an obj-file")
  41.             ELSIF res = 3 THEN
  42.                 Str(" imports ");
  43.                 Str(Modules.imported); Str(" with bad key")
  44.             ELSIF res = 4 THEN Str(" corrupted obj file")
  45.             ELSIF res = 6 THEN Str(" has too many imports")
  46.             ELSIF res = 7 THEN Str(" not enough space")
  47.             END
  48.         ELSIF res < 0 THEN Str(name); Str(" not found")
  49.         END;
  50.         IF res # 0 THEN Ln; Texts.Append(Oberon.Log, wr.buf) END
  51.     END ErrorMsg;
  52.     PROCEDURE GetXEHandler;
  53.         VAR save, par: Oberon.ParList; res: INTEGER;
  54.     BEGIN
  55.         save := Oberon.Par;
  56.         NEW(par); NEW(par.frame); par.frame.X := 0; par.frame.Y := 0; par.pos := -210566;    (* magic *)
  57.         Oberon.Call("XE.GetHandler", par, FALSE, res);
  58.         IF res = 0 THEN xeHandle := Oberon.Par.frame.handle
  59.         ELSE xeHandle := TextFrames.Handle
  60.         END;
  61.         Oberon.Par := save
  62.     END GetXEHandler;
  63.     PROCEDURE Save(X, Y, W, H: INTEGER);    (* copy from screen X, Y, W, H into save area *)
  64.     BEGIN
  65.         Pictures.Create(saveArea,W,H,Amiga.Depth);
  66.         Pictures.CopyBlock(Display.screen,saveArea,X,Y,W,H,0,0,replace)
  67.     END Save;
  68.     PROCEDURE Restore(X, Y, W, H: INTEGER);    (* restore from save area to screen X, Y, W, H *)
  69.     BEGIN
  70.         Pictures.CopyBlock(saveArea,Display.screen,0,0,W,H,X,Y,replace)
  71.     END Restore;
  72.     (* auxiliary *)    
  73.     PROCEDURE Min(x, y: INTEGER): INTEGER;    BEGIN IF x < y THEN RETURN x ELSE RETURN y END END Min;
  74.     PROCEDURE Max(x, y: INTEGER): INTEGER;    BEGIN IF x > y THEN RETURN x ELSE RETURN y END END Max;
  75.     PROCEDURE CopyText(from: Texts.Text): Texts.Text;
  76.         VAR to: Texts.Text;
  77.     BEGIN Texts.Save(from, 0, from.len, buf); to := TextFrames.Text(""); Texts.Append(to, buf); RETURN to
  78.     END CopyText;
  79.     PROCEDURE DefaultMenu(e: Elem);
  80.     BEGIN
  81.         IF e.menu.len > 0 THEN Texts.Delete(e.menu, 0, e.menu.len) END;
  82.         Str("right interclick to edit menu"); Ln; Texts.Append(e.menu, wr.buf)
  83.     END DefaultMenu;
  84.     PROCEDURE GetName(e: Elem; t: Texts.Text; pos: LONGINT);
  85.         VAR s: Texts.Scanner;
  86.     BEGIN
  87.         Texts.OpenScanner(s, t, pos); Texts.Scan(s);
  88.         IF ~(s.class IN {Texts.Name, Texts.String}) OR (s.s[0] = 0X) THEN e.name := "Popup" ELSE COPY(s.s, e.name) END
  89.     END GetName;
  90.     PROCEDURE StrDispWidth(fnt: Fonts.Font; s: ARRAY OF CHAR): LONGINT;
  91.         VAR pat: Display.Pattern; width, i, dx, x, y, w, h: INTEGER;
  92.     BEGIN
  93.         width := 0; i := 0;
  94.         WHILE s[i] # 0X DO Display.GetChar(fnt.raster, s[i], dx, x, y, w, h, pat); INC(width, dx); INC(i) END;
  95.         RETURN LONG(width)*DUnit
  96.     END StrDispWidth;
  97.     PROCEDURE DispStr(fnt: Fonts.Font; s: ARRAY OF CHAR; col, x0, y0: INTEGER);
  98.         VAR pat: Display.Pattern; i, dx, x, y, w, h: INTEGER;
  99.     BEGIN
  100.         i := 0;
  101.         WHILE s[i] # 0X DO
  102.             Display.GetChar(fnt.raster, s[i], dx, x, y, w, h, pat);
  103.             Display.CopyPattern(col, pat, x0+x, y0+y, paint);
  104.             INC(i); INC(x0, dx)
  105.         END
  106.     END DispStr;
  107.     (* change propagation *)    
  108.     PROCEDURE PrepareDraw(e: Elem; fnt: Fonts.Font; VAR dy: INTEGER);
  109.         VAR width, dh: INTEGER;
  110.     BEGIN
  111.         IF menuElem IN e.options THEN width := 0; dh := 0; dy := fnt.minY; IF dy > -2 THEN dy := -2 END
  112.         ELSE width := 2*ElemDW+4; dh := -fnt.minY+2*ElemDH+2 END;
  113.         e.W := LONG(width)*DUnit+StrDispWidth(fnt, e.name)+DUnit; e.H := LONG(fnt.maxY-fnt.minY+dh)*DUnit
  114.     END PrepareDraw;
  115.     PROCEDURE PrepareMenu(e: Elem);
  116.         VAR r: Texts.Reader; ch, oldCh: CHAR; width, dx, x, y, w, h: INTEGER; p: LONGINT;
  117.     BEGIN
  118.         e.width := 0; e.n := 1; e.lsp := 0; width := 0; oldCh := 0X;
  119.         Texts.OpenReader(r, e.menu, 0); Texts.Read(r, ch);
  120.         WHILE ~r.eot DO
  121.             IF ch = CR THEN e.width := Max(e.width, width); width := 0; INC(e.n)
  122.             ELSE
  123.                 e.lsp := Max(e.lsp, r.fnt.height); e.dsc := Min(e.dsc, r.fnt.minY);
  124.                 Display.GetChar(r.fnt.raster, ch, dx, x, y, w, h, p); INC(width, dx)
  125.             END;
  126.             oldCh := ch; Texts.Read(r, ch)
  127.         END;
  128.         IF oldCh = CR THEN DEC(e.n) END;
  129.         IF (oldCh = 0X) OR (e.n = 0) OR (e.width+width = 0) THEN    (* ensure non_empty text *)
  130.             DefaultMenu(e); PrepareMenu(e)
  131.         ELSE e.width := Max(e.width, width); e.default := Min(e.default, e.n-1)
  132.         END
  133.     END PrepareMenu;
  134.     (* interactive editing of popup menus *)    
  135.     PROCEDURE HandleEdit(f: Display.Frame; VAR msg: Display.FrameMsg);
  136.         VAR f1: EditFrame;
  137.     BEGIN
  138.         xeHandle(f, msg);(*TextFrames.Handle(f, msg)*)
  139.         WITH f: EditFrame DO
  140.             IF msg IS Oberon.CopyMsg THEN
  141.                 NEW(f1);
  142.                 TextFrames.Open(f1, f.text, f.org);
  143.                 f1.handle := f.handle; f1.elem := f.elem; msg(Oberon.CopyMsg).F := f1
  144.             END
  145.         END
  146.     END HandleEdit;
  147.     PROCEDURE OpenEditor(e: Elem);
  148.         CONST menu = "System.Close  Edit.Search  Edit.Replace  PopupElems.Toggle Menu Line  PopupElems.Update ";
  149.         VAR v: MenuViewers.Viewer; f: EditFrame; x, y, i: INTEGER; name: ARRAY 34 OF CHAR;
  150.     BEGIN
  151.         name[0] := 22X; i := 0;    (* 22X = " *)
  152.         WHILE e.name[i] # 0X DO name[i+1] := e.name[i]; INC(i) END;
  153.         name[i+1] := 22X; name[i+2] := 0X;
  154.         Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  155.         NEW(f); f.elem := e; TextFrames.Open(f, CopyText(e.menu), 0); f.handle := HandleEdit;
  156.         v := MenuViewers.New(TextFrames.NewMenu(name, menu), f, TextFrames.menuH, x, y)
  157.     END OpenEditor;
  158.     (* file input/output *)    
  159.     PROCEDURE Load(VAR r: Files.Rider; e: Elem);
  160.         VAR ch: CHAR; val: LONGINT;
  161.     BEGIN
  162.         Files.Read(r, ch);
  163.         IF ch = VersionTag THEN
  164.             Files.ReadString(r, e.name);
  165.             Files.ReadNum(r, val); e.default := SHORT(val);
  166.             Files.ReadSet(r, e.options); e.options := e.options*{menuElem, underlined};
  167.             e.menu := TextFrames.Text(""); Texts.Load(r, e.menu)
  168.         ELSE
  169.             Files.Set(r, Files.Base(r), Files.Pos(r)-1);
  170.             Files.ReadString(r, e.name);
  171.             Files.Read(r, ch);
  172.             IF ch >= 80X THEN e.options := {menuElem, underlined} ELSE e.options := {} END;
  173.             e.default := ORD(ch) MOD 128;
  174.             e.menu := TextFrames.Text(""); Texts.Load(r, e.menu)
  175.         END
  176.     END Load;
  177.     PROCEDURE Store(VAR r: Files.Rider; e: Elem);
  178.     BEGIN
  179.         Files.Write(r, VersionTag);
  180.         Files.WriteString(r, e.name); Files.WriteNum(r, e.default); Files.WriteSet(r, e.options);
  181.         Texts.Store(r, e.menu)
  182.     END Store;
  183.     (* graphics *)    
  184.     PROCEDURE Box(col, bkgnd, X, Y, W, H: INTEGER);
  185.     BEGIN
  186.         Display.ReplConst(col, X+1, Y+1, W-2, 1, replace);
  187.         Display.ReplConst(col, X+1, Y+H-2, W-2, 1, replace);
  188.         Display.ReplConst(col, X+1, Y+2, 1, H-4, replace);
  189.         Display.ReplConst(col, X+W-2, Y+2, 1, H-4, replace);
  190.         Display.ReplConst(col, X+4, Y, W-4, 1, replace);
  191.         Display.ReplConst(col, X+W-1, Y+1, 1, H-4, replace);
  192.         Display.ReplConst(bkgnd, X+2, Y+2, W-4, H-4, replace)
  193.     END Box;
  194.     PROCEDURE Underline(f: Display.Frame; col, X, Y, W: INTEGER);
  195.     BEGIN Display.ReplPatternC(f, white, Display.grey1, X, Y, W, 1, X, Y, invert)
  196.     END Underline;
  197.     PROCEDURE DrawElem(e: Elem; f: Display.Frame; pos: LONGINT; fnt: Fonts.Font; col, X, Y: INTEGER);
  198.         VAR beg: LONGINT; parc: TextFrames.Parc; bkgndCol: INTEGER;
  199.     BEGIN
  200.         IF f IS TextFrames.Frame THEN bkgndCol := f(TextFrames.Frame).col ELSE bkgndCol := black END;
  201.         IF menuElem IN e.options THEN
  202.             TextFrames.ParcBefore(Texts.ElemBase(e), pos, parc, beg);
  203.             INC(Y, SHORT(parc.dsr DIV DUnit));
  204.             IF bkgndCol = col THEN col := ABS(white-col) END
  205.         ELSE
  206.             Box(col, bkgndCol, X, Y, SHORT((e.W-1) DIV DUnit), SHORT(e.H DIV DUnit));
  207.             INC(X, ElemDW+2); INC(Y, ElemDH+2-fnt.minY)
  208.         END;
  209.         DispStr(fnt, e.name, col, X, Y);
  210.         IF e.options*{menuElem, underlined} = {menuElem, underlined} THEN
  211.             Underline(f, col, X, Y-2, SHORT(e.W DIV DUnit))
  212.         END
  213.     END DrawElem;
  214.     PROCEDURE PrintElem(e: Elem; fnt: Fonts.Font; X, Y: INTEGER);
  215.         VAR W, H: INTEGER;
  216.     BEGIN
  217.         W := SHORT((e.W-1) DIV PUnit); H := SHORT(e.H DIV PUnit);
  218.         IF menuElem IN e.options THEN
  219.             Printer.String(X, Y, e.name, fnt.name);
  220.             IF underlined IN e.options THEN Printer.ReplConst(X, Y-2, W, 1) END
  221.         ELSE
  222.             Printer.ReplConst(X+1, Y+1, W-2, 1);
  223.             Printer.ReplConst(X+1, Y+H-2, W-2, 1);
  224.             Printer.ReplConst(X+1, Y+2, 1, H-4);
  225.             Printer.ReplConst(X+W-2, Y+2, 1, H-4);
  226.             Printer.ReplConst(X+4, Y, W-4, 1);
  227.             Printer.ReplConst(X+W-1, Y+1, 1, H-4);
  228.             Printer.String(X + (ElemDW+2) * DUnit DIV PUnit,
  229.                 Y + SHORT(LONG(ElemDH+2-fnt.minY)*DUnit DIV PUnit), e.name, fnt.name
  230.         END
  231.     END PrintElem;
  232.     PROCEDURE DrawMenu(e: Elem; X, Y, W, H: INTEGER);
  233.         VAR r: Texts.Reader; ch: CHAR; X0, dx, x, y, w, h: INTEGER; p: LONGINT;
  234.     BEGIN
  235.         Box(white, black, X, Y, W, H);
  236.         X0 := X+MenuDW+2; X := X0; Y := Y+H-e.lsp-e.dsc-MenuDH-2;
  237.         Texts.OpenReader(r, e.menu, 0); Texts.Read(r, ch);
  238.         WHILE ~r.eot DO
  239.             IF ch = CR THEN Y := Y-e.lsp; X := X0
  240.             ELSE
  241.                 Display.GetChar(r.fnt.raster, ch, dx, x, y, w, h, p);
  242.                 Display.CopyPattern(r.col, p, X+x, Y+y, paint); INC(X, dx)
  243.             END;
  244.             Texts.Read(r, ch)
  245.         END
  246.     END DrawMenu;
  247.     (* actions *)    
  248.     PROCEDURE Show(f: Display.Frame; e: Elem; pos: LONGINT; X, Y: INTEGER; VAR cmd: INTEGER; VAR keySum: SET);
  249.         VAR
  250.             eX, eY, eW, eH, W, H, w, newY, mx, my, top, bot, left, right, newCmd: INTEGER;
  251.             keys: SET;
  252.             parc: TextFrames.Parc; beg: LONGINT;
  253.             default: BOOLEAN;
  254.         PROCEDURE FlipLine;
  255.         BEGIN Display.ReplConst(white, eX, eY, eW, 2, invert)
  256.         END FlipLine;
  257.         PROCEDURE Flip(cmd: INTEGER);
  258.         BEGIN IF cmd >= 0 THEN Display.ReplConst(white, left, top-(cmd+1)*e.lsp, right-left, e.lsp, invert) END
  259.         END Flip;
  260.     BEGIN
  261.         eX := X; eY := Y; eW := SHORT(e.W DIV DUnit); eH := SHORT(e.H DIV DUnit);
  262.         IF (menuElem IN e.options) & (e.n = 1) THEN    (* one_liner MenuElem *)
  263.             TextFrames.ParcBefore(Texts.ElemBase(e), pos, parc, beg);
  264.             newY := eY+SHORT(parc.dsr DIV DUnit);
  265.             IF underlined IN e.options THEN Underline(f, white, eX, newY-2, eW) END;
  266.             FlipLine; newCmd := cmd;
  267.             REPEAT
  268.                 Input.Mouse(keys, mx, my); keySum := keySum+keys;
  269.                 Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mx, my);
  270.                 IF (keySum = cancel) OR (mx < eX) OR (mx >= eX+eW) OR (my < eY) OR (my >= eY+eH) THEN newCmd := -1
  271.                 ELSIF (cmd = -1) & (eX <= mx) & (mx < eX+eW) & (eY <= my) & (my < eY+eH) THEN newCmd := e.default
  272.                 END;
  273.                 IF newCmd # cmd THEN FlipLine; cmd := newCmd END
  274.             UNTIL keys = {};
  275.             IF cmd # -1 THEN FlipLine END;
  276.             IF underlined IN e.options THEN Underline(f, white, eX, newY-2, eW) END
  277.         ELSE
  278.             Input.Mouse(keys, mx, my);
  279.             W := e.width + 2*MenuDW + 4; H := e.n*e.lsp + 2*MenuDH + 4;
  280.             IF (W > Oberon.DisplayWidth(X)) OR (H > Oberon.DisplayHeight(X)) THEN
  281.                 Str("PopupElem too big!"); Ln; Texts.Append(Oberon.Log, wr.buf);
  282.                 REPEAT Input.Mouse(keys, mx, my); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mx, my)
  283.                 UNTIL keys = {};
  284.                 keySum := cancel; cmd := -1
  285.             ELSE
  286.                 w := Oberon.DisplayWidth(X); left := Display.Left;
  287.                 X := Min(w-W, Max(mx-W DIV 2, left));    (* X >= left & X+W <= w *)
  288.                 newY := my-((e.n-cmd)*e.lsp-e.lsp DIV 2);
  289.                 IF (newY >= Display.Bottom) & (newY+H <= Oberon.DisplayHeight(X)) THEN    (* popup at mouse pos *)
  290.                     Y := newY; default := FALSE
  291.                 ELSE    (* drop down *)
  292.                     IF Y-H > Display.Bottom THEN Y := Y-H ELSE Y := Y+eH END;
  293.                     IF Y+H > Oberon.DisplayHeight(X) THEN Y := Display.Bottom END;
  294.                     default := TRUE
  295.                 END;
  296.                 left := X+3; right := X+W-3; bot := Y+MenuDH+3; top := Y+H-MenuDH-2;
  297.                 Oberon.RemoveMarks(X, Y, W, H); Oberon.FadeCursor(Oberon.Mouse);
  298.                 Save(X, Y, W, H);    (* save background *)
  299.                 DrawMenu(e, X, Y, W, H);
  300.                 Flip(cmd); keySum := {};
  301.                 REPEAT
  302.                     Input.Mouse(keys, mx, my); keySum := keySum+keys;
  303.                     Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mx, my);
  304.                     IF keySum = cancel THEN cmd := -1
  305.                     ELSIF (mx >= left) & (mx <= right) & (my >= bot) & (my <= top) THEN
  306.                         newCmd := (top-my) DIV e.lsp;
  307.                         IF newCmd # cmd THEN default := FALSE; Flip(cmd); Flip(newCmd); cmd := newCmd END
  308.                     ELSIF default THEN
  309.                         IF (eX <= mx) & (mx < eX+eW) & (eY <= my) & (my < eY+eH) THEN
  310.                             IF cmd # e.default THEN cmd := e.default; Flip(cmd) END
  311.                         ELSE Flip(cmd); cmd := -1
  312.                         END
  313.                     ELSIF ~default THEN Flip(cmd); cmd := -1
  314.                     END
  315.                 UNTIL keys = {};
  316.                 Oberon.FadeCursor(Oberon.Mouse);
  317.                 Restore(X, Y, W, H)    (* restore background *)
  318.             END
  319.         END
  320.     END Show;
  321.     PROCEDURE Popup(e: Elem; msg: TextFrames.TrackMsg);
  322.         VAR
  323.             cmd, res: INTEGER; s: Texts.Scanner; r: Texts.Reader; ch: CHAR; keys: SET;
  324.             par: Oberon.ParList;
  325.     BEGIN
  326.         keys := msg.keys; cmd := e.default;
  327.         Show(msg.frame, e, msg.pos, msg.X0, msg.Y0, cmd, keys);
  328.         IF keys = {MM, MR} THEN OpenEditor(e)
  329.         ELSIF (keys # cancel) & (cmd > -1) THEN
  330.             e.default := cmd;
  331.             Texts.OpenReader(r, e.menu, 0); Texts.Read(r, ch);
  332.             WHILE cmd > 0 DO IF ch = CR THEN DEC(cmd) END; Texts.Read(r, ch) END;
  333.             Texts.OpenScanner(s, e.menu, Texts.Pos(r)-1); Texts.Scan(s);
  334.             IF (s.class = Texts.Name) & (s.line = 0) THEN
  335.                 NEW(par); par.frame := msg.frame;
  336.                 IF (menuElem IN e.options) & (e.n = 1) & s.eot THEN    (* setup text following MenuElem as parameter *)
  337.                     par.text := Texts.ElemBase(e); par.pos := msg.pos+1
  338.                 ELSE par.text := e.menu; par.pos := Texts.Pos(s)-1
  339.                 END;
  340.                 Oberon.Call(s.s, par, ML IN keys, res);    (* left interclick -> unload module *)
  341.                 IF res # 0 THEN ErrorMsg(s.s, res) END
  342.             END
  343.         END
  344.     END Popup;
  345.     (* element *)    
  346.     PROCEDURE Handle(e: Texts.Elem; VAR msg: Texts.ElemMsg);
  347.         VAR copy: Elem;
  348.     BEGIN
  349.         WITH e: Elem DO
  350.             IF msg IS TextFrames.DisplayMsg THEN
  351.                 WITH msg: TextFrames.DisplayMsg DO
  352.                     IF msg.prepare THEN PrepareDraw(e, msg.fnt, msg.Y0)
  353.                     ELSE DrawElem(e, msg.frame, msg.pos, msg.fnt, msg.col, msg.X0, msg.Y0)
  354.                     END
  355.                 END
  356.             ELSIF msg IS TextPrinter.PrintMsg THEN
  357.                 WITH msg: TextPrinter.PrintMsg DO
  358.                     IF ~msg.prepare THEN PrintElem(e, msg.fnt, msg.X0, msg.Y0) END
  359.                 END
  360.             ELSIF msg IS Texts.CopyMsg THEN
  361.                 WITH msg: Texts.CopyMsg DO
  362.                     NEW(copy); Texts.CopyElem(e, copy);
  363.                     copy.name := e.name; copy.menu := CopyText(e.menu);
  364.                     copy.n := e.n; copy.default := e.default; copy.width := e.width; copy.lsp := e.lsp; copy.dsc := e.dsc;
  365.                     copy.options := e.options;
  366.                     msg.e := copy
  367.                 END
  368.             ELSIF msg IS Texts.IdentifyMsg THEN
  369.                 WITH msg: Texts.IdentifyMsg DO
  370.                     msg.mod := "PopupElems"; msg.proc := "Alloc"
  371.                 END
  372.             ELSIF msg IS Texts.FileMsg THEN
  373.                 WITH msg: Texts.FileMsg DO
  374.                     IF msg.id = Texts.load THEN Load(msg.r, e); PrepareMenu(e)
  375.                     ELSIF msg.id = Texts.store THEN Store(msg.r, e)
  376.                     END
  377.                 END
  378.             ELSIF msg IS TextFrames.TrackMsg THEN
  379.                 WITH msg: TextFrames.TrackMsg DO Popup(e, msg) END
  380.             END
  381.         END
  382.     END Handle;
  383.     PROCEDURE Alloc*;
  384.         VAR e: Elem;
  385.     BEGIN NEW(e); e.handle := Handle; Texts.new := e
  386.     END Alloc;
  387.     (** commands **)    
  388.     PROCEDURE insert(options: SET);
  389.         VAR e: Elem; ins: TextFrames.InsertElemMsg;
  390.     BEGIN
  391.         NEW(e); GetName(e, Oberon.Par.text, Oberon.Par.pos); e.options := options;
  392.         e.menu := TextFrames.Text(""); DefaultMenu(e); PrepareMenu(e);
  393.         e.handle := Handle; ins.e := e; Viewers.Broadcast(ins)
  394.     END insert;
  395.     PROCEDURE Insert*;    BEGIN insert({underlined}) END Insert;
  396.     PROCEDURE InsertMenu*;    BEGIN insert({menuElem, underlined}) END InsertMenu;
  397.     PROCEDURE Toggle*;    (** "Menu" | "Line"    Change option of element(s) in frame below or in selected text **)
  398.         VAR f: TextFrames.Frame; s: Texts.Scanner; r: Texts.Reader; t: Texts.Text; flag: INTEGER; beg, end, time: LONGINT;
  399.         PROCEDURE Translate(str: ARRAY OF CHAR; VAR val: INTEGER);
  400.         BEGIN
  401.             IF str = "Menu" THEN val := menuElem
  402.             ELSIF str = "Line" THEN val := underlined
  403.             ELSE val := -1
  404.             END
  405.         END Translate;
  406.         PROCEDURE Change(e: Elem; opt: INTEGER);
  407.             VAR text: Texts.Text;
  408.         BEGIN
  409.             e.options := e.options / {opt};
  410.             text := Texts.ElemBase(e);
  411.             IF text # NIL THEN text.notify(text, Texts.replace, Texts.ElemPos(e), Texts.ElemPos(e)+1) END
  412.         END Change;
  413.     BEGIN
  414.         IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN
  415.             f := Oberon.Par.frame(TextFrames.Frame);
  416.             IF f.hasSel THEN Texts.OpenScanner(s, f.text, f.selbeg.pos)
  417.             ELSE Texts.OpenScanner(s, f.text, Oberon.Par.pos)
  418.             END;
  419.             Texts.Scan(s);
  420.             IF s.class = Texts.Name THEN
  421.                 Translate(s.s, flag);
  422.                 IF flag # -1 THEN Change(f.next(EditFrame).elem, flag) END
  423.             END
  424.         ELSE
  425.             Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  426.             IF s.class = Texts.Name THEN
  427.                 Oberon.GetSelection(t, beg, end, time);
  428.                 IF time >= 0 THEN
  429.                     Translate(s.s, flag);
  430.                     IF flag # -1 THEN
  431.                         Texts.OpenReader(r, t, beg); Texts.ReadElem(r);
  432.                         WHILE (Texts.Pos(r) <= end) & (r.elem # NIL) DO
  433.                             IF r.elem IS Elem THEN Change(r.elem(Elem), flag) END;
  434.                             Texts.ReadElem(r)
  435.                         END
  436.                     END
  437.                 END
  438.             END
  439.         END
  440.     END Toggle;
  441.     PROCEDURE Update*;
  442.         VAR f: EditFrame; e: Elem; s: Texts.Scanner; menuText, text: Texts.Text; pos: LONGINT;
  443.     BEGIN
  444.         IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN
  445.             f := Oberon.Par.frame.next(EditFrame); e := f.elem; menuText := Oberon.Par.frame(TextFrames.Frame).text;
  446.             GetName(e, menuText, 0);
  447.             Texts.OpenScanner(s, menuText, 0); Texts.Scan(s);
  448.             IF ~(s.class IN {Texts.Name, Texts.String}) OR (s.s[0] = 0X) THEN s.s := "Popup" END;
  449.             COPY(s.s, e.name); e.menu := CopyText(f.text);
  450.             PrepareMenu(e);
  451.             text := Texts.ElemBase(e);
  452.             IF text # NIL THEN
  453.                 pos := Texts.ElemPos(e); text.notify(text, Texts.replace, pos, pos+1);
  454.                 Texts.OpenReader(s, menuText, menuText.len-1); Texts.Read(s, s.c);
  455.                 IF s.c = "!" THEN Texts.Delete(menuText, menuText.len-1, menuText.len) END
  456.             END
  457.         END
  458.     END Update;
  459. BEGIN NEW(buf); Texts.OpenBuf(buf); Texts.OpenWriter(wr); GetXEHandler; NEW(saveArea)
  460. END PopupElems.
  461.